//	COPYRIGHT (C) 1981 BY BOARD OF TRUSTEES,
//	LELAND STANFORD JUNIOR UNIVERSITY

//APRIL 25, 1978
//COMMONLY USED UTILITY ROUTINES FOR BCPL-CONGEN
//AND RELATED PROGRAMS.  WRITTEN BY RAY CARHART.
//FREE VARIABLES NOT DECLARED IN FILE: NONE, BUT
//THE THREE EXTERNALS MAKDEV, MAKPPN AND SAVEXT ARE USED BY TOPORSTOP TO
//LOCATE THE DEVICE, PPN AND EXTENSION ON WHICH THE CONGEN MONITOR
//LIVES (SEE DEPPEX.MAC).  TOPORSTOP DOESN'T CLOSE FILES.
EXTERNAL $( MAKDEV; MAKPPN; CARPPN; CONPPN; CRAPPN; DAGPPN; DRWPPN; DTBPPN; DNDPPN; GRYPPN; NRSPPN; LIBPPN; SAVEXT $);
// ADDITIONAL PPNs ADDED BY NABG (OCTOBER 79), THESE ARE FOR POINTERS
// TO PROGRAMS THAT RESIDE IN DIFFERENT DIRECTORIES
// CARPPN --- RAY CARHART'S DIRECTORY
// CONPPN --- "CONGEN" DIRECTORY
// CRAPPN --- CHRIS CRANDELL'S DIRECTORY
// DAGPPN --- MARY DAGEFORDE'S DIRECTORY
// DTBPPN --- "DATABASE" DIRECTORY.
// DNDPPN --- DENDRAL
// DRWPPN --- "GRAPHICS" DIRECTORY
// GRYPPN --- NABG'S DIRECTORY
// NRSPPN --- JIM NOURSE'S DIRECTORY
// LIBPPN --- DIRECTORY CONTAINING SUBSTRUCTURE LIBRARIES

LET RUNCGPART(SIXBITNAME) BE
 $[ $MOVE 2,MAKDEV;
    $MOVE 3,SIXBITNAME;
    $MOVE 4,SAVEXT;
    $SETZM 0,5;
    $MOVE 6,MAKPPN;
    $SETZM 0,7;
    $MOVSI 1,0;
    $HRRI 1,2;
    $RUN 1,0;
    $HALT
 $];

MANIFEST $( PLUSINF = #377777777777; MINUSINF = #400000000000 $);
STATIC $( TERMPOSITION = 0 $);

LET MAPSTR(STR,FN) BE
 $( STATIC $( NCH = NIL; CHOFF = NIL $)
 NCH:=!STR>>29;
 CHOFF:=29;
 WHILE NCH>0 DO
  $(
  NCH-:=1;
  CHOFF-:=7;
  IF CHOFF<0 DO $( STR+:=1; CHOFF:=29 $);
  FN(#177 BITAND [!STR>>CHOFF])
  $)
 $);

LET SIXBIT(STR) = VALOF
 $( STATIC $( SIXWORD = NIL; OFFSET = NIL $);
 
 LET PUTCH6(CH) BE
  $(
  OFFSET:=OFFSET-6;
  SIXWORD:=SIXWORD BITOR [[[CH-#40] BITAND #77]<<OFFSET]
  $);

 SIXWORD:=0;
 OFFSET:=36;
 MAPSTR(STR,PUTCH6);
 RESULTIS SIXWORD
 $);

LET OUTNOS(N) BE $( OUTNO(N); SPACES(1) $);

LET OUTNOL(N) BE $( OUTNO(N); NEWLINE(1) $);

LET OUTOCT(N) BE FOR I=33 TO 0 BY -3 DO OUTNO([N>>I] BITAND #7);

LET NCHARSN(N) = VALOF
 $( STATIC $( ANS = NIL $);
 ANS:=(N>0 -> 0,1);
 WHILE N NE 0 DO $( ANS:=ANS+1; N:=N/10 $);
 RESULTIS ANS
 $);

LET OUTNON(N,SPACE) BE
 $(
 SPACE:=SPACE-NCHARSN(N);
 IF SPACE>0 DO SPACES(SPACE);
 OUTNO(N)
 $);

LET BLT(FROMLOC,TOLOC,LASTLOC) BE
 $[ $HRR 2,TOLOC;
    $HRL 2,FROMLOC;
    $BLT 2,@LASTLOC
 $];

LET INVPERMUTE(V,PERM,SCRATCH,LOWE,HIGHE) BE
 $( STATIC $( I = NIL $);
 I:=LOWE-1;
 WHILE I<HIGHE DO $( I+:=1; SCRATCH![PERM!I]:=V!I $);
 BLT(SCRATCH+LOWE,V+LOWE,V+HIGHE)
 $);

 LET RANKORDER(SCORES,LOWE,HIGHE,NEGABSFLAG) = VALOF
  $( STATIC $( ORDERING = NIL; I = NIL; J = NIL; LOWSCORE = NIL;
               LOWIX = NIL; SCOREJ = NIL $);
  ORDERING:=NEWVEC(HIGHE);
  I:=LOWE-1;
  WHILE I<HIGHE DO $( I+:=1; ORDERING!I:=0 $);
  WHILE I GE LOWE DO
   $(
   LOWSCORE:=PLUSINF;
   J:=HIGHE+1;
   WHILE J>LOWE DO
    $(
    J-:=1;
    IF ORDERING!J NE 0 DO LOOP;
    SCOREJ:=(NEGABSFLAG -> -ABS[SCORES!J],SCORES!J);
    IF LOWSCORE LE SCOREJ DO LOOP;
    LOWSCORE:=SCOREJ;
    LOWIX:=J
    $);
   ORDERING!LOWIX:=I;
   I-:=1
   $);
  RESULTIS ORDERING
  $);

LET OUTCHP(CH) BE
 $(
 IF TERMPOSITION>71 DO $( NEWLINE(1); TERMPOSITION:=0 $);
 OUTCH(CH);
 TERMPOSITION+:=1
 $);

LET MSDAYTIME() = VALOF
 $[ $CALLI 1,#23 $];

LET MSRUNTIME() = VALOF
 $[ $SETZM 0,1;
    $CALLI 1,#27
 $];

//  	CHANGE APR '81 BY ALF
//	FROM CTLCCHAN = 35 TO CNTLCCHAN = 0
//	TO MAKE TENEX AND TOPS-20 VERSIONS ALIKE

MANIFEST $( CTLCCHAN = 0; CTLCLEV = 1 $);
STATIC $( SOMECTLC = 0; CTLCINITTED = FALSE $);

LET INITCTLC() BE
  $[ $HRRZI 1,#400000; //FOR THE CURRENT FORK,
     #104000000150; //CALL RPCAR JSYS TO GET CAPABILITIES.
     $HRLZI 4,#400000; //SET BIT 0 IN 4;
     $IOR 3,4; //AND IOR IT INTO 3.
     #104000000151; //SET NEW CAPABILITIES (INCL CTL-C, NOW) WITH EPCAP JSYS.
     #104000000144; //NEXT DO AN RIR JSYS
     $HRRZ 2,2; //AND GET CHNTAB ADDRESS IN 2.
     $HRRZI 1,CATCHCC; //GET ADDRESS OF CTL-C HANDLER
     $HRLI 1,CTLCLEV; //AND INTERRUPT LEVEL IN 1
     $MOVEM 1,CTLCCHAN(2); //AND MOVE THIS INFO TO CHNTAB LOCATION.
     $HRRZI 1,#400000; //NOW FOR THE CURRENT FORK
     #104000000134; //DO RCM JSYS TO GET CURRENTLY ACTIVE CHANNELS IN 1.
     $HRLZI 2,#400000; //NOW PUT A LEFTMOST BIT IN 2
     $LSH 2,-CTLCCHAN; //AND SHIFT IT INTO CHANNEL'S BIT POSN.
     $IOR 2,1;  //NOW OR TOGETHER ALL ACTIVATED-CHANNEL BITS
     $HRRZI 1,#400000; //AND FOR THIS FORK,
     #104000000131; //ACTIVATE ALL CHANNELS IN THE RESULT.
     $( RETURN $);
     CATCHCC: //CTL-C HANDLER
     $SETOM 0,SOMECTLC; //RECORD THE FACT THAT A ^C WAS SEEN
     #104000000136 //AND DEBREAK (DEBRK JSYS)
  $]

LET INTERRUPTABLE(TORF) BE
 TEST TORF THEN
  $[ $MOVEI 1,3; //GET TERMINAL CODE FOR ^C IN 1
     #104000000140; //AND DEASSIGN IT VIA THE DTI JSYS.

//	CHANGE APR '81 BY ALF
//	TO ALLOW USER TO TYPE CONT AFTER ^C WITH NO PROBLEMS

     $( TEST SOMECTLC=0 		//IF NO ^C WAS SEEN
	THEN RETURN 			//THEN CONTINUE AS USUAL
	OR $( OUTS("^C*C*L") 		//ELSE - OUTPUT ^C 'MESSAGE'
	      SOMECTLC:=0  $)		//AND RESET ^C COUNTER  THEN
     $);

//	END OF CHANGE BY ALF		

     #104000000170  //HALT THE FORK IF ANY "CAUGHT" CTL-C
  $]
 OR
  $[ $( UNLESS CTLCINITTED DO $( INITCTLC(); CTLCINITTED:=TRUE $) $);
     $HRRI 1,CTLCCHAN; //PUT CHANNEL NUMBER
     $HRLI 1,3; //AND CHARACTER CODE FOR ^C INTO 1
     #104000000137 //AND DO THE ATI JSYS TO ASSOCIATE CHAR WITH CHAN
  $];

//THE FOLLOWING IS INTENDED TO DO THE ANALOGOUS
//^C-CATCHING FOR TOPS-10; NOT TESTED AT ALL
//STATIC $( INTBLK = VEC 3; CCFLAG = 0 $);
//
//LET INITCC() BE
// $( STATIC $( PCLOC = NIL; SAV1 = NIL; SAVPC = NIL $);
// $[ $(
//    INTBLK!0:=[4<<18]+@CCHANDLER;
//    INTBLK!1:=2;
//    INTBLK!2:=0;
//    INTBLK!3:=0
//    PCLOC:=INTBLK+2;
//    RETURN
//    $);
//    CCHANDLER:
//    $MOVEM 1,SAV1;
//    $MOVE 1,@PCLOC;
//    $MOVEM 1,SAVPC;
//    $MOVE 1,SAV1;
//    $SETOM 0,CCFLAG;
//    $SETZM 0,@PCLOC;
//    $JRST 0,@SAVPC
// $]
// $);
//
//LET INTERRUPTABLE(TORF) BE
// $( STATIC $( OOUT = NIL $);
// TEST TORF THEN
//  $(
//  ![#134]:=0;
//  UNLESS CCFLAG NE 0 DO RETURN;
//  OOUT:=OUTPUT;
//  OUTPUT:=TTY;
//  OUTS("^C*C*L");
//  $[ $EXIT 0,0 $];
//  OUTPUT:=OOUT;
//  RETURN
//  $)
// OR $( INITCC(); ![#134]:=INTBLK $)
// $);

LET FILEEXISTS(FNAME,FEXT) = VALOF
 $( STATIC $( SCB = NIL $);
 SCB:=FINDFILE("DSK",FNAME,FEXT,0,LABEL(FALSEOUT));
 ENDREAD(SCB);
 RESULTIS TRUE;
 FALSEOUT:
 RESULTIS FALSE
 $);

//LET FILEEXISTS(FNAME,FEXT) = VALOF
// $( STATIC $( JFN = NIL $);
// JFN:=GETJFN(FNAME,FEXT,FALSE);
// IF JFN=0 DO RESULTIS FALSE;
// $[ #104000000023; //RELEASE JFN WITH RLJFN JSYS
//    #104000000170 $]; //HALTF ON ERROR RETURN
// RESULTIS TRUE
// $);

EXTERNAL "%" $( RENAME:RENAM; DELETE:DELET $);

LET DELETEFILE(FNAME,FEXT) = VALOF
 $( STATIC $( SCB = NIL $);
 SCB:=FINDFILE("DSK",FNAME,FEXT,0,LABEL(FALSEOUT));
 DELETE(SCB);
 ENDREAD(SCB);
 RESULTIS TRUE;
 FALSEOUT:
 RESULTIS FALSE
 $);

LET RENAMEFILE(OFNAME,OFEXT,NFNAME,NFEXT) = VALOF
 $( STATIC $( SCB = NIL $);
 SCB:=FINDFILE("DSK",OFNAME,OFEXT,0,LABEL(FALSEOUT));
 RENAME(SCB,NFNAME,NFEXT);
 ENDREAD(SCB);
 RESULTIS TRUE;
 FALSEOUT:
 RESULTIS FALSE
 $);

//LET DELETEFILE(FNAME,FEXT) = VALOF
// $( STATIC $( JFN = NIL $);
// JFN:=GETJFN(FNAME,FEXT,FALSE);
// IF JFN=0 DO RESULTIS FALSE;
// $[ $MOVE 1,JFN;
//    #104000000675; //PURGE THE FILE WITH PRGE JSYS (SUMEX-SPECIFIC)
//    #104000000170; //HALTF JSYS - HALTS ON ERROR RETURN
//    #104000000023; //RELEASE JFN WITH RLJFN JSYS
//    #104000000170 //HALTF ON ERROR RETURN
// $];
// RESULTIS TRUE
// $);

//LET RENAMEFILE(OFNAME,OFEXT,NFNAME,NFEXT) = VALOF
// $( STATIC $( OJFN = NIL; NJFN = NIL $);
// OJFN:=GETJFN(OFNAME,OFEXT,FALSE);
// IF OJFN=0 DO RESULTIS FALSE;
// NJFN:=GETJFN(NFNAME,NFEXT,TRUE);
// $[ $MOVE 1,OJFN;
//    $MOVE 2,NJFN;
//    #104000000035; //RENAME WITH RNAMF JSYS
//    #104000000170; //HALTF JSYS TO HALT ON ERROR RETURN
//    $MOVE 1,NJFN;
//    #104000000023; //RELEASE NJFN (RNAMF RELEASES OJFN) WITH RLJFN JSYS
//    #104000000170 //HALTF JSYS TO HALT ON ERROR RETURN
// $];
// RESULTIS TRUE
// $);

LET FILEREPLACE(REPNAME,REPEXT,BYNAME,BYEXT) BE 
 $(
 DELETEFILE(REPNAME,REPEXT);
 RENAMEFILE(BYNAME,BYEXT,REPNAME,REPEXT)
 $);

LET COPYTOEND() BE
 $( STATIC $( CHAR = NIL $);
 CHAR:=INCH();
 WHILE CHAR NE ENDSTREAMCH DO $( OUTCH(CHAR); CHAR:=INCH() $)
 $);

LET NCHARS(STR) = [!STR]>>29;

LET OUTSN(STR,N,TRUNCATE) BE
 $(
 N-:=NCHARS(STR);
 TEST N GE 0 THEN $( SPACES(N); OUTS(STR) $)
 OR
  TEST TRUNCATE THEN
   $( STATIC $( OLDW1 = NIL $);
   OLDW1:=!STR;
   !STR:=!STR+[N<<29];
   OUTS(STR);
   !STR:=OLDW1
   $)
  OR OUTS(STR)
 $);

LET JOBNO() = VALOF $[ $CALLI 1,#30 $];

//LET JOBNO() = VALOF $[ #104000000013; $MOVE 1,3 $];

LET ADD3DIG(V,N) = VALOF
 $(
//PLACES CHARACTER CODES FOR THE LAST THREE DIGITS OF N INTO THE
//FIRST THREE LOCATIONS OF V.
 N:=N REM 1000;
 V!1:='0'+N/100;
 N:=N REM 100;
 V!2:='0'+N/10;
 V!3:='0'+[N REM 10];
 RESULTIS V
 $);

LET TOPFILENAME() = VALOF 
 $( STATIC $( FNAME = 0; V1 = VEC 6; V2 = VEC 6 $);
 IF FNAME=0 DO FNAME:=PACKSTRING(ADD3DIG(UNPACKSTRING("000TOP",V1),JOBNO()),V2);
 RESULTIS FNAME
 $);

LET STRFILENAME() = VALOF 
 $( STATIC $( FNAME = 0; V1 = VEC 6; V2 = VEC 6 $);
 IF FNAME=0 DO FNAME:=PACKSTRING(ADD3DIG(UNPACKSTRING("000STR",V1),JOBNO()),V2);
 RESULTIS FNAME
 $);

LET SC1FILENAME() = VALOF 
 $( STATIC $( FNAME = 0; V1 = VEC 6; V2 = VEC 6 $);
 IF FNAME=0 DO FNAME:=PACKSTRING(ADD3DIG(UNPACKSTRING("000SC1",V1),JOBNO()),V2);
 RESULTIS FNAME
 $);

LET SC2FILENAME() = VALOF 
 $( STATIC $( FNAME = 0; V1 = VEC 6; V2 = VEC 6 $);
 IF FNAME=0 DO FNAME:=PACKSTRING(ADD3DIG(UNPACKSTRING("000SC2",V1),JOBNO()),V2);
 RESULTIS FNAME
 $);


LET SC3FILENAME() = VALOF 
 $( STATIC $( FNAME = 0; V1 = VEC 6; V2 = VEC 6 $);
 IF FNAME=0 DO FNAME:=PACKSTRING(ADD3DIG(UNPACKSTRING("000SC3",V1),JOBNO()),V2);
 RESULTIS FNAME
 $);

LET STIFILENAME() = VALOF 
 $( STATIC $( FNAME = 0; V1 = VEC 6; V2 = VEC 6 $);
 IF FNAME=0 DO FNAME:=PACKSTRING(ADD3DIG(UNPACKSTRING("000STI",V1),JOBNO()),V2);
 RESULTIS FNAME
 $);

LET MSFFILENAME() = VALOF 
 $( STATIC $( FNAME = 0; V1 = VEC 6; V2 = VEC 6 $);
 IF FNAME=0 DO FNAME:=PACKSTRING(ADD3DIG(UNPACKSTRING("000MSF",V1),JOBNO()),V2);
 RESULTIS FNAME
 $);

LET MSPFILENAME() = VALOF 
 $( STATIC $( FNAME = 0; V1 = VEC 6; V2 = VEC 6 $);
 IF FNAME=0 DO FNAME:=PACKSTRING(ADD3DIG(UNPACKSTRING("000MSP",V1),JOBNO()),V2);
 RESULTIS FNAME
 $);

LET NMRFILENAME() = VALOF 
 $( STATIC $( FNAME = 0; V1 = VEC 6; V2 = VEC 6 $);
 IF FNAME=0 DO FNAME:=PACKSTRING(ADD3DIG(UNPACKSTRING("000NMR",V1),JOBNO()),V2);
 RESULTIS FNAME
 $);

STATIC $( CGEXT = "CG" $);

GET "RECFNS.BCL"

LET STARTCGPART(CGPARTNAME) BE $(
	RECTERM(); RUNCGPART(SIXBIT(CGPARTNAME)) $);

LET STARTCGPART1(APPN,CGPARTNAME) BE 
	$( MAKPPN:=APPN; STARTCGPART(CGPARTNAME) $);

LET TOPORSTOP() BE STARTCGPART1(MAKPPN,"STRCHK");

LET PIART(STR) BE
 $(
 SWITCHON [[!STR]>>22] BITAND #177 INTO
  $(
  CASE 'A': CASE 'E': CASE 'I': CASE 'O': CASE 'U': CASE 'Y':
   OUTS("AN "); ENDCASE;
  DEFAULT: OUTS("A ")
  $);
 OUTS(STR)
 $);

LET OUTSIF(STR) BE IF INPUT=TTY DO OUTS(STR);

LET OUTNOIF(N) BE IF INPUT=TTY DO OUTNO(N);

LET OUTCHIF(CH) BE IF INPUT=TTY DO OUTCH(CH);

LET INS0(EMPTYOK) = VALOF
 $( STATIC $( STR = VEC 20; STRTAIL = NIL; CHAR = NIL; OFFSET = NIL;
              NCHAR = NIL $);
 !STR:=0;
 OFFSET:=22;
 STRTAIL:=STR;
 NCHAR:=0;
 CHLOOP:
 CHAR:=INCH();
 IF 'a' LE CHAR LE 'z' DO CHAR:=CHAR-'a'+'A';
 SWITCHON CHAR INTO
  $(
  CASE ' ': CASE ',': GOTO CHLOOP;
  CASE '*C': INCH();
  CASE '*L': TEST EMPTYOK THEN RESULTIS "" OR GOTO CHLOOP
  CASE '*E': TEST EMPTYOK THEN RESULTIS "" OR $(
	OUTPUT:=TTY
	OUTS("HAVE HIT END OF FILE --- PROGRAM DIES.*C*L")
	FINISH
	$)
  $);
 PUTCHLOOP:
 IF OFFSET<0 DO $( STRTAIL:=STRTAIL+1; !STRTAIL:=0; OFFSET:=29 $);
 NCHAR:=NCHAR+1;
 !STRTAIL:=!STRTAIL BITOR [CHAR<<OFFSET];
 OFFSET:=OFFSET-7;
 CHAR:=INCH();
 SWITCHON CHAR INTO
  $(
  CASE '*C': INCH();
  CASE ' ': CASE '*L': CASE ',': CASE '*E' :
   !STR:=!STR BITOR [NCHAR<<29];
   RESULTIS STR
  $)
 GOTO PUTCHLOOP;
 $);

LET INS() = VALOF INS0(FALSE);

LET COPYS(STR) = VALOF
 $( STATIC $( STR2 = NIL; NSWDS = NIL $);
 NSWDS:=[!STR>>29]/5;
 STR2:=NEWVEC(NSWDS);
 BLT(STR,STR2,STR2+NSWDS);
 RESULTIS STR2
 $);

LET STREQUAL(STR1,STR2) = VALOF
 $( STATIC $( I=NIL $);
 IF !STR1 NE !STR2 DO RESULTIS FALSE;
 I:=[!STR1>>29]/5;
 WHILE I>0 DO
  $(
  I-:=1;
  STR1+:=1;
  STR2+:=1;
  IF !STR1 NE !STR2 DO RESULTIS FALSE
  $);
 RESULTIS TRUE
 $);

STATIC $( RETPART = NIL; RETDEV = NIL; RETPPN = NIL; RETEXT = NIL $);

LET READRETURN() BE
 $( RETPART:=COPYS(INS()); RETDEV:=INNO(); RETPPN:=INNO();
    RETEXT:=INNO(); INCH() $);

LET EXECUTERETURN() BE
 $( MAKDEV:=RETDEV; MAKPPN:=RETPPN; SAVEXT:=RETEXT; STARTCGPART(RETPART) $);

LET WRITERETTOME(STR) BE
 $( OUTS(STR); SPACES(1); OUTNOS(MAKDEV); OUTNOS(MAKPPN); OUTNOS(SAVEXT) $);

LET WRITEMYRET() BE
 $( OUTS(RETPART); SPACES(1); OUTNOS(RETDEV); OUTNOS(RETPPN); OUTNOS(RETEXT) $);



